perm filename PLTIT.F4[MSS,LCS]3 blob
sn#133856 filedate 1974-11-30 generic text, type T, neo UTF8
00001 C**** PLTCMD, FILLMS, ROTATE ********
00005 SUBROUTINE PLTCMD
00009 CC IMPLICIT INTEGER(A-Q,S-Z)
00013 COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK
00017 DIMENSION NMS(8),RMOV1(8),RMOV2(8)
00021 COMMON /DL/RSIZ,SAVER,NAME /ALF/INP(72),ML
00025 COMMON RJB,JE,CENTR,JB,RJQ(20),JQ(20)
00029 EQUIVALENCE (RJE,RJQ(3)),(RJF,RJQ(4)),(RJG,RJQ(5)),(RJD,RJQ(2))
00033 1,(RJC,RJQ(1)),(I2,INP(2)),(RJH,RJQ(6)),(NMS(1),INP(31))
00037 1,(RMOV1(1),INP(39))
00041 C BE CAREFUL OF COMMON OVERLAPS WITH NOTWRT,ITMSUB,HOMER, ETC.
00045 CC 1,(RMOV1(1),INP(21)),(RMOV2(1),INP(31))
00049 F78F(1)='(78F)'
00053 FA5(1)='(A5) '
00057 FA1(1)='(A1) '
00061
00065 IF(I2.NE.'X')GO TO 1
00073 I2=0
00077 RXC=0
01800 RMOV1(1)='Y'
01900 NAME=0
02000 14 KA=0
02100 3 KA=KA+1
02300 IF(ML.EQ.0)GO TO 15
02400 K=K-2
02500 ML=ML-1
02600 IF(ML.EQ.0)GO TO 10
02700 GO TO 31
02800 15 TYPE 2,KA
02900 ACCEPT 11,K,ML
03000 C TYPE LAST NAME, NUMBER FOR A SERIES
03100 50 IF(K.EQ.' ')GO TO 10
03200 IF(K.EQ.'99')GO TO 140
03300 C 99=BACKUP
03400 31 IF(LOOKD(K))GO TO 56
03500 C JUMP IF FILE FOUND
03600 TYPE 55
03700 GO TO 15
03800 55 FORMAT(' FILE NOT FOUND'/)
03900 11 FORMAT(A5,I)
04000 56 NMS(KA)=K
04200 IF(ML.EQ.0)GO TO 5
04300 RJH='Y'
04400 GO TO 21
04500 5 TYPE 8
04600 ACCEPT FA5,RJH
04700 IF(RJH.EQ.'99')GO TO 15
04800 IF(RJH.NE.'Y')RJH=0
04900 IF(RJH.EQ.0)REREAD F78F,RJH
05000 C MOVE NUMBER CAN BE TYPED FOR 'MOVE UP'
05100 21 RMOV1(KA+1)=RJH
05200 RMOV2(KA)=RJH
05300 GO TO 3
05400 140 KA=KA-1
05500 GO TO 15
05600
05700 10 KB=KA-1
05800 IF(I3.NE.'G')GO TO 22
05900 RSIZ=1
06000 GO TO 222
06100 22 TYPE 9
06200 ACCEPT F78F,RSIZ
06300 IF(RSIZ.EQ.99.OR.RSIZ.EQ.0)GO TO 5
06400 222 KA=0
06500
06600 1 IF(NAME.NE.0)GO TO 12
06700 IF(KA.EQ.KB)CALL PLOT(0,0,99)
06800 NAME=NMS(KA+1)
06900 TYPE 111,NAME
07000 RETURN
07100 12 KA=KA+1
07200 NAME=0
07500 C 'PXC' = CALCOMP OUTPUT
07600 RJH=0
07700 RJB=RSIZ
07800 RJC=RSIZ
08000 C FOR FILLER. SIZES .LT. 1.6 = EVERY SCAN LINE, .LT. 2.6 = 2, ETC.
08100 RJG=0
08200 RJE=1
08300 RJF=1
08400 IF(RMOV2(KA).NE.'Y')RJG=RMOV2(KA)
08500 IF(RMOV1(KA).NE.0)RJE=0
08600 IF(RMOV2(KA).NE.0.OR.RJG.NE.0)RJF=0
08700 2 FORMAT(' TYPE FILE NAME',I2,1X$)
08800 8 FORMAT(' MOVE UP AT END? ',$)
08900 9 FORMAT(' SIZE FACTOR? ',$)
09000 111 FORMAT(1XA5/)
09100 END
09200
09300
09400
09500 C****** CHANGE 3, 4 AND 5 TO JFCL IN DDT WHEN USING DISTORTION.(SEE 'LINES')
09600 SUBROUTINE FILLMS(L,IDAT,RJB,CENTR,RJF,RJG)
09700 COMMON/DL/RSIZ,SAVER,NAME
09800 COMMON/DST/BB,CC/FLM/X(200),Y(200),NX(200)
09900 DIMENSION IDAT(1)
10000 COMMON/PLTR/IPLT,RHT,DIS/LL/LL/STF/RR(8),RSTJC
10200 C MD=DISPLAY MP=PLOTTER MX=XGP
10250 DATA M2/2/
10300 DX=DIS
10400 RX=RHT
10500 D=RSTJC*RJF
10600 R=RSTJC*RJG
10700 4 GO TO 1
10800 C=CC
10900 B=BB
11000 C SAVES IT. IT WILL RETURN LATER.
11100 BB=B/DIS
11200 CC=1000
11300 1 KK=0
11400 DO 205 J=1,L
11500 CALL UNPACK(M,N,IDAT(J))
11600 KK=KK+1
11700 NX(KK)=0
11800 IF(LL.EQ.3)NX(KK)=3
11900 X(KK)=ROFF((RJB+D*M)*DIS)
12000 Y(KK)=ROFF((CENTR+R*N)*RHT)
12100 3 GO TO 205
12200 Y(KK)=Y(KK)*(C-BB*(ABS(X(KK))))
12300 C FOR DISTORTION
12400 205 CONTINUE
12500 NX(1)=KK
12600 DIS=1.0
12700 RHT=DIS
12900 IF(IPLT)M=RSIZ+.4
13000 IF(M.LE.0)M=1
13050 IF(M.GT.M2)M=M2
13100 C STOPS DISTORTION IN 'LINES'
13200 2 CALL FILLER(X,Y,NX,M)
13300 DIS=DX
13400 RHT=RX
13500 5 RETURN
13600 C NEXT TO RESET DISTORTION FACT.
13700 BB=B
13800 CC=C
13900 RETURN
14000 END
14100
14200 SUBROUTINE ROTATE(I,L)
14300 DIMENSION I(1)
14500 COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/STF/RR(8),RSTJC
14600 EQUIVALENCE (RJF,RJQ(4)),(RJG,RJQ(5)),(DEG,RJQ(7))
14700 RJG=RJG*RSTJC
14800 RJF=RJF*RSTJC
14900 N=I(L)
15000 KNT=601
15100 C ROTATED DATA IS PUT BACK STARTING AT LOCATION 601.
15200 I(KNT)=N
15300 DO 1 K=L+1,N+L-1
15400 CALL UNPACK(J,M,I(K))
15500 X=J*RJF
15600 Y=M*RJG
15700 JJ=I(K)/100000000
15800 AX=ATAN2(X,Y)*57.29578
15900 HYP=SQRT(X**2+Y**2)
16000 ROT=DEG+AX
16100 J=ROFF(HYP*COSD(ROT))
16200 M=ROFF(HYP*SIND(ROT))
16300 KNT=KNT+1
16400 IF(J)J=1000-J
16500 IF(M)M=1000-M
16600 1 I(KNT)=M*10000+J+JJ*100000000
16700 L=601
16800 RJF=1.
16900 RJG=1.
17000 RSTJC=1.
17100 C SIZE CHANGES MUST BE MADE BEFORE ROTATION!!!!! ELSE IT DISTORTS.
17200 END
20000
20010 SUBROUTINE PLOT(J,K,L)
20020 CALL PLOTX(J,K,L)
20030 END
20040 C TO ROTATE 90 DEG. CHANGE IN DDT AT 1M - 'JUMP J' TO 'JUMP K' AND VS-VS.
20100
30000 SUBROUTINE PLOTX(I,J,K)
30200 DIMENSION N(128)
30210 IF(JJ)GO TO 4
30220 L=1
30237 N(1)=127
30255 CALL PUTFIL('PLT')
30277 JJ=-1
30300 4 IF(K.EQ.99)GO TO 1
30400 L=L+1
30500 CALL PAC(N(L),I)
30550 CC N(L)=J+5000+(I+5000)*10000+(K+4)*100000000
30575 C PACKS PX000Y000
30600 3 IF(L.LT.128)RETURN
30700 2 CALL FASTOU(N,128)
30800 L=1
30900 RETURN
31000 1 N(1)=L-1
31100 CALL FASTOU(N,128)
31200 CALL FINFIL
31250 JJ=0
31275 CALL EXIT
31300 END
31400
31500 SUBROUTINE PLOTS(K)
31600 C DUMMY
31700 END